Collection of Tools & Utilities/Collection of Tools and Utilities.iso/pascal/zindent7.zip/ZINSTR.INC

Text File | 1987-03-30 | 14KB | 610 lines

(********************************************************************)
(*                                                                  *)
(*  Include File  STRING.INC                                        *)
(*  Library of common string  PROCEDURES                            *)
(*  v. 0800am, sun, 28.Mar.87, Glen Ellis                           *)
(*                                                                  *)
(********************************************************************)

(*---

Major routines summary :

pAllCaps (line) upper case full line
pUpCaseFirst (line) upper case first word

pTrim* (line) simple trim spaces
pTrim*Cnt (line,x) trim with counter

pPad* (line,len) simple pad spaces
pPad*Cnt (line,cnt) pad with counter

pExpand* (line,chx,max) complex pad
pShrink* (line,chx,max) complex trim
pJust* (line,len)

pIndent complex required by KEYWORD
pLineCount prefixes linecount str

pSayLnCJ (line,linelen);
pSayLnLJ (line,linelen);
pSayLnRJ (line,linelen);

pSayReadCJ (line,linelen,readlen);
pSayReadLM (line,linelen,readlen);

pIndent() left margin restoration used by KeyWord procedures.
pINDENT( var iLine : THEstr; iPos : integer; iMax : integer);

---*)


(********************************************************************)

procedure    pALLCAPS( var LINE : thestr );

var i : integer;

begin
   FOR i := 1 to length(line)
      do  Line[i] := upcase(Line[i]);
end;


(********************************************************************)

procedure    pUpCaseFirst( var LINE : thestr );

var i, max : integer;

begin
   IF pos(' ',line) > 1 then max := pos(' ',line)
   ELSE max := length(line);
   FOR i := 1 to max
      do  Line[i] := upcase(Line[i]);
end;

(********************************************************************)

procedure pTrimL( var line : thestr);

(* line length is shortened *)

var
byte : string1;
len  : integer;

begin (* proc *)
   IF length(line) > 1
   then
   begin
      (* fetch byte on extreme left end *)
      byte := Line[1];
      (* trim left end <space> character, if len > 1 *)
      while byte = ' ' do
      begin
         IF length(line) > 0
         then
         begin
            delete(Line,1,1);
            byte := Line[1];      (* next delete char *)
         end
         ELSE   (* force while loop to exit *)
         byte := '.';
      end; (* while *)
   end; (* if *)
end; (* proc *)


(********************************************************************)

procedure pTrimR(var line : THEstr );

(* line length is shortened *)

var
byte : string1;
len  : integer;

begin (* proc *)
   IF length(line) > 1
   then
   begin
      (* fetch byte on extreme right end *)
      len := length(Line);
      byte := LINE[Len];
      (* trim right end <space> character *)
      WHILE (Byte = ' ') do
      begin
         IF length(line) > 0
         then
         begin
            delete(Line,Len,1);
            Len := length(Line);
            Byte := Line[Len];
         end
         ELSE   (* force while loop to exit *)
         byte := '.';
      end; (* while *)
   end; (* if *)
end; (* proc *)


(********************************************************************)

procedure pTrimLR( var LRLine : thestr );

(* trim left / trim right *)
(* line length is shortened *)

var
byte : string1;
len  : integer;

begin (* proc *)
   IF length(LRline) > 1 then
   begin
      pTrimR( LRLine );
      pTrimL( LRLine );
   end; (* if *)
end; (* proc *)


(********************************************************************)

procedure pTrimLCnt( var Line : thestr ; var Cnt : nbr );

(* trim left and count spaces *)
(* line length is shortened *)
(* Count is useful for restoring, or re-margining a text line. *)

var
byte : string1;
len  : integer;

begin (* proc *)
   IF length(line) > 1
   then
   begin
      (* fetch byte on extreme left end *)
      byte := Line[1];
      Cnt := 0;
      (* trim left end <space> character, if len > 1 *)
      WHILE byte = ' '
      do
      begin
         IF length(line) > 0
         then
         begin
            delete(Line,1,1);
            byte := Line[1];      (* next delete char *)
            Cnt := Cnt+1;
         end
         ELSE   (* force while loop to exit *)
         byte := '.';
      end; (* while *)
   end; (* if *)
end; (* proc *)


(********************************************************************)

procedure pTrimRCnt(var Line : THEstr; var Cnt : nbr );

(* trim right and count spaces *)
(* line length is shortened *)
(* Count is usefile for restoring, or re-margining a text line. *)

var
byte : string1;
len  : integer;

begin (* proc *)
   IF length(line) > 1
   then
   begin
      (* fetch byte on extreme right end *)
      len := length(Line);
      byte := line[Len];
      Cnt := 0;
      (* trim right end <space> character *)
      WHILE (Byte = ' ')
      do
      begin
         IF length(line) > 0
         then
         begin
            delete(Line,Len,1);
            Len := length(Line);
            Byte := Line[Len];
            Cnt := Cnt+1;
         end
         ELSE   (* force while loop to exit *)
         byte := '.';
      end; (* while *)
   end; (* if *)
end; (* proc *)



(********************************************************************)

procedure pTrimLCntR( var LCRline : thestr ; var Cnt : nbr );

(* trim left and count spaces / trim right and without counting spaces *)
(* line length is shortened *)
(* called by KeyWord procedures *)

var
byte : string1;
len  : integer;

begin (* proc *)
   IF length(LCRline) > 1
   then
   begin
      pTrimR( LCRline );
      pTrimLCnt( LCRline, Cnt );
   end;
end; (* proc *)



(********************************************************************)

procedure pPADL(var LINE : THEstr ; LEN : integer);

(* LINE  = incoming string to be altered
(* LEN   = left margin length
*)

var
y : integer;
mark : string1;

begin (* proc *)
   mark   := ' ';
   FOR y := 1 to len
      do line := mark + line;
end; (* proc *)


(********************************************************************)

procedure pPADR(var LINE : THEstr ; LEN : integer);

(* LINE  := incoming string to be altered
(* LEN   := right margin length
*)

var
y : integer;
mark : string1;

begin (* proc *)
   mark   := ' ';
   FOR y := 1 to len
      do line := line + mark;
end; (* proc *)


(***************************************************************************)

procedure pEXPANDL(var LINE :THEstr; CHX :string1; MAX :integer);

(* LINE   = incoming string to be altered
(* CHX   = character to use
(* MAX   = max length of expanded line
*)

var
y : integer;

begin (* proc *)
   WHILE length(line) < max
      do line := chx + line;
end; (* proc *)


(***************************************************************************)

procedure pEXPANDR(var LINE :THEstr; CHX :string1; MAX :integer);

(* LINE   = incoming string to be altered
(* CHX   = character to use
(* MAX   = max length of expanded line
*)

var
y : integer;

begin (* proc *)
   WHILE length(line) < max
      do line := line + chx;
end; (* proc *)


(********************************************************************)

procedure pSHRINKL(var LINE :THEstr; CHX :string1; MIN :integer);

(* shrink the line, not less than minimum length
(* LINE   = incoming string to be altered
(* CHX   = character to use
(* MIN   = min length of shrinked line
*)

begin (* proc *)
   pTRIML(LINE);
   pEXPANDL(LINE,CHX,min);
end; (* proc *)


(********************************************************************)

procedure pSHRINKR(var LINE :THEstr; CHX :string1; MIN :integer);

(* purpose : shrink line, not less than minimum length
(* LINE   = incoming string to be altered
(* CHX   = character to use
(* MIN   = min length of shrinked line
*)

begin (* proc *)
   pTRIMR(LINE);
   pEXPANDR(LINE,CHX,min);
end; (* proc *)


(******